VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Converter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'Number of tools in this server
Const NUM_TOOLS = 1
'Toggle this to test loading buttons from .Bmp/.Res
Const boolLoadFromBmp As Boolean = False
'Return a description string for this package of tools
Public Property Get Description() As String
    Description = LoadResString(101) '"TurboCAD File Converter"
End Property

'Called to perform tool function
Public Function Run(ByVal Tool As Object) As Boolean
'    On Error Resume Next
On Error GoTo E
Err.Clear
    Set ObjApp = Tool.Application
    If ObjApp Is Nothing Then
        MsgBox LoadResString(102) & Err.Description & LoadResString(103)
        Exit Function
    End If
    Set Drs = ObjApp.Drawings
    If Drs Is Nothing Then
        MsgBox LoadResString(104) & Err.Description & LoadResString(103)
        Exit Function
    End If
    
' store current setting for ask Summary Info dialog on drawing save
    isSummInfo = ObjApp.Properties("PromptForSummaryInfo").Value
' disable ask for Summary Info dialog on drawing save
    ObjApp.Properties("PromptForSummaryInfo") = False
    frmConverter.Show vbModal
' restore original setting
    ObjApp.Properties("PromptForSummaryInfo") = CLng(isSummInfo)
 
    Set Drs = Nothing
    Set ObjApp = Nothing
    
    Run = True
    Exit Function
E:
    MsgBox "Run failed " & Err.Description
    Set Drs = Nothing
    Set ObjApp = Nothing

End Function

'Fill arrays with information about tools in the package
'Return the number of tools in the package
Public Function GetToolInfo(CommandNames As Variant, MenuCaptions As Variant, StatusPrompts As Variant, _
    ToolTips As Variant, Enabled As Variant, WantsUpdates As Variant) As Long
    
    Dim sICmd As String
    
    'ReDim CommandNames(NUM_TOOLS, 5)
    ReDim CommandNames(NUM_TOOLS) ', 5)
    ReDim MenuCaptions(NUM_TOOLS, 2)
    ReDim StatusPrompts(NUM_TOOLS)
    ReDim ToolTips(NUM_TOOLS)
    ReDim Enabled(NUM_TOOLS)
    ReDim WantsUpdates(NUM_TOOLS)
    
    sICmd = LoadResString(105) '"S&DK|&Utils|File &Converter"
    CommandNames(0) = sICmd + "#CMD_SDKFILECONVERTER"
    
    MenuCaptions(0, 0) = LoadResString(106) '"&File Converter"
    MenuCaptions(0, 1) = LoadResString(107) '"SDK"
    
    StatusPrompts(0) = LoadResString(108) '"Launch the File Converter"
    ToolTips(0) = LoadResString(109) '"File Converter"
    Enabled(0) = True
    WantsUpdates(0) = False
    GetToolInfo = NUM_TOOLS
End Function


'Copy a windows bitmap of the requested size to the clipboard
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire bitmap:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono bitmap should be 1-bit (black or white)
Public Function CopyBitmap(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Boolean
    On Error GoTo BitmapError
    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        'Put the image on the Windows clipboard
        Clipboard.SetData TheImage, vbCFDIB
        CopyBitmap = True
        Exit Function
    End If
BitmapError:
    CopyBitmap = False
End Function

'Return a Picture object for the requested size
'Apparently, returning references to StdPicture objects doesn't work for .EXE servers
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire image:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono image should be 1-bit (black or white)
Public Function GetPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Object
    On Error GoTo PictureError
    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        Set GetPicture = TheImage
        Exit Function
    End If

PictureError:
    Set GetPicture = Nothing
End Function

'Returns true if tool is correctly initialized
Public Function Initialize(ByVal Tool As Object) As Boolean
    Initialize = True
End Function

'Returns true if tool is correctly initialized
Public Function UpdateToolStatus(ByVal Tool As Object, Enabled As Boolean, Checked As Boolean) As Boolean
    Enabled = True 'Could do a test here to determine whether to disable the button/menu item
    Checked = False  'Could do a test here to determine whether to check the button/menu item
    UpdateToolStatus = True
End Function

'Implementation specific stuff
'Private function to return the bitmap from .Res file or .Bmp file
Private Function GetButtonPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean, TheImage As StdPicture) As Boolean
    On Error GoTo LoadError

    'There are two ways to load images:  from .Bmp file(s) or from .RES resource.
    'In this demo, we control the loading by a private variable.
    
    'Note that if you are loading from .Bmp, or if you are running this tool as a
    '.VBP for debugging, you must place the .Res or .Bmp files in the Draggers subdirectory
    'of the directory in which TCW40.EXE (or IMSIGX40.DLL) is located.

    If boolLoadFromBmp Then
        'Load from .Bmp file
        Dim strFileName As String 'File name of .Bmp file to load

        If LargeImage Then
            strFileName = App.Path & "\bmp2.bmp"
        Else
            strFileName = App.Path & "\bmp1.bmp"
        End If
        Set TheImage = LoadPicture(strFileName)
    Else
        'Load from .Res file
        Dim idBitmap%  'BITMAP resource id in .Res file

        If LargeImage Then
            idBitmap% = 102
        Else
            idBitmap% = 101
        End If
        Set TheImage = LoadResPicture(idBitmap%, vbResBitmap)
    End If

    'Return the image
    GetButtonPicture = True
    Exit Function

LoadError:
'        MsgBox "Error loading bitmap: " & Err.Description
        MsgBox LoadResString(113) & Err.Description
    GetButtonPicture = False
End Function
